home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr52 / 5333de.zip / 3.PRG < prev    next >
Text File  |  1993-04-03  |  856b  |  38 lines
  1. // Update the client files CA of the Pears
  2. // This variation takes APPEND out of the loop.
  3. // and it takes the CA.dbf out completely.
  4.  
  5. clear
  6. private I
  7.  
  8. FOR I = 1 TO 6000
  9.    X = NEW_ID("CA")
  10.    ? "REC#"+str(I,4)+"   "
  11.    ?? "string= "+str(memory(0),4)+"K  "+;
  12.                 "free  = "+str(memory(1),4)+"K  "+;
  13.                 "run   = "+str(memory(2),4)+"K  "+;
  14.                 "EMM   = "+str(memory(3),4)+"K  "
  15. next
  16.  
  17. Function NEW_ID(P1)
  18. ***************************************
  19. *
  20. ***************************************
  21. private   R,;   && returns the latest ID
  22.           W,;  && saves the previous workarea chosen
  23.           D
  24.  
  25. W = select()
  26. use IDS NEW
  27. locate for DS == PadR(P1, 8)
  28. if found()
  29.       D = val(NEWID)+1
  30.       R := PadL( D, len(trim(NEWID)), "0")
  31.       replace NEWID with R
  32. endif
  33.  
  34. use
  35. select (W)
  36. return R
  37.  
  38.